home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / delphi.swg / 0061_Resizable control at runtime.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-24  |  5.8 KB  |  223 lines
  1. {
  2. The following is a unit I wrote yesterday. I am uploading it because it is a
  3. failed component - failed because it ultimately could not do what I needed.
  4. What I needed were resizeable bloxes (hotspots if you will) over a graphic.
  5. I created a component and setup 8 boxes at the perimeter for resizing and
  6. developed the code for the control to be moved (by clicking and holding
  7. while moving inside the control) or resized (at one of the 8 resize blocks
  8. around the edge).  The failure was that after I got all this working I could
  9. not find a way to make the window transparent or automatically copy the area
  10. underneath to its canvas.  I had to have a transparent hotspot - not one
  11. pushbutton grey!
  12.  
  13. Anyway, when the user presses the mouse button down I take the X,Y, make it
  14. a point and do ClientToScreen on it - I also store the location of the
  15. control in parent coordinates.  Later, when I get the OnMouseMove call, I
  16. take the new X,Y position, convert it to screen coordinates and take the
  17. difference of the original mouse X,Y to the new mouse X,Y and apply that to
  18. the original window X,Y.
  19.  
  20. I am redoing this control as a descendant of TPaintBox so it can have the
  21. graphic and handling the hotspots as a TList instead of individual windows.
  22. Easier on resources as well.
  23. }
  24. unit Hotspot;
  25.  
  26. interface
  27.  
  28. uses
  29.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  30.   Forms, Dialogs;
  31.  
  32. type
  33.   THotspot = class(TCustomControl)
  34.   private
  35.     { Private declarations }
  36.     xDown: Integer;
  37.     yDown: Integer;
  38.     ptDown: TPoint;
  39.     dragging: Integer;
  40.     wDrag: Integer;
  41.     rcDown: TRect;
  42.     rcDrag: Array [0..7] of TRect;
  43.     rcCursor: Array [0..7] of TCursor;
  44.  
  45.   protected
  46.     { Protected declarations }
  47.     property OnMouseDown;
  48.     property OnMouseUp;
  49.     property OnMouseMove;
  50.  
  51.   public
  52.     { Public declarations }
  53.         constructor Create(AOwner: TComponent); override;
  54.  
  55.         procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  56.     procedure Paint; override;
  57.         procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  58.     procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift:
  59. TShiftState; X, Y: Integer);
  60.     procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift:
  61. TShiftState; X, Y: Integer);
  62.  
  63.   published
  64.     { Published declarations }
  65.   end;
  66.  
  67. procedure Register;
  68.  
  69. implementation
  70.  
  71. procedure Register;
  72. begin
  73.   RegisterComponents('Samples', [THotspot]);
  74. end;
  75.  
  76. constructor THotspot.Create(AOwner: TComponent);
  77. var
  78.     win: Longint;
  79. begin
  80.     inherited Create(AOwner);
  81.   Canvas.Brush.Style := bsClear;
  82.   dragging := -1;
  83.   wDrag := 5;
  84.  
  85.   OnMouseMove := MouseMove;
  86.   OnMouseDown := MouseDown;
  87.   OnMouseUp := MouseUp;
  88.   ParentColor := True;
  89.  
  90.   rcCursor[0] := crSizeNWSE;
  91.   rcCursor[1] := crSizeNS;
  92.   rcCursor[2] := crSizeNESW;
  93.   rcCursor[3] := crSizeWE;
  94.   rcCursor[4] := crSizeNWSE;
  95.   rcCursor[5] := crSizeNS;
  96.   rcCursor[6] := crSizeNESW;
  97.   rcCursor[7] := crSizeWE;
  98. end;
  99.  
  100. procedure THotspot.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  101. var
  102.     r,b,r2,b2: Integer;
  103.     wDrag2: Integer;
  104. begin
  105.     r := AWidth;
  106.   b := AHeight;
  107.   r2:= r div 2;
  108.   b2 := b div 2;
  109.     wDrag2 := wDrag div 2;
  110.  
  111.   rcDrag[0] := Rect(0,0,wDrag,wDrag);
  112.   rcDrag[1] := Rect(r2-wDrag2,0,r2+wDrag2,wDrag);
  113.   rcDrag[2] := Rect(r-wDrag+1,0,r,wDrag);
  114.   rcDrag[3] := Rect(r-wDrag+1,b2-wDrag2,r,b2+wDrag2);
  115.   rcDrag[4] := Rect(r-wDrag+1,b-wDrag,r,b);
  116.   rcDrag[5] := Rect(r2-wDrag2,b-wDrag,r2+wDrag2,b);
  117.   rcDrag[6] := Rect(0,b-wDrag,wDrag,b);
  118.   rcDrag[7] := Rect(0,b2-wDrag2,wDrag,b2+wDrag2);
  119.  
  120.     inherited SetBounds(ALeft,ATop,AWidth,AHeight);
  121. end;
  122.  
  123. procedure THotspot.Paint;
  124. var
  125.     rc: TRect;
  126.   i,w: Integer;
  127. begin
  128.     with Canvas do begin
  129.     Pen.Style := psDot;
  130.     if dragging = -1 then
  131.       Pen.Color := clBlack
  132.     else
  133.       Pen.Color := clWhite;
  134.     rc := GetClientRect;
  135.     w := wDrag div 2;
  136.     Rectangle(w,w,rc.right-w,rc.bottom-w);
  137.  
  138.     Brush.Style := bsSolid;
  139.     Brush.Color := Pen.Color;
  140.     Pen.Style := psSolid;
  141.     for i := 0 to 7 do
  142.         Rectangle(rcDrag[i].Left,rcDrag[i].Top,rcDrag[i].Right,rcDrag[i].Bottom);
  143.     Brush.Style := bsClear;
  144.     end;
  145. end;
  146.  
  147. procedure THotspot.MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
  148. Integer);
  149. var
  150.     i: Integer;
  151.   pt: TPoint;
  152.   xDif,yDif: Integer;
  153.  
  154.   procedure SetW(leftOff,topOff,rightOff,bottomOff: Integer);
  155.   var
  156.       rc: TRect;
  157.   begin
  158.       rc := rcDown;
  159.     Inc(rc.Left,leftOff);
  160.     Inc(rc.Top,topOff);
  161.     Inc(rc.Right,rightOff);
  162.     Inc(rc.Bottom,bottomOff);
  163.     SetBounds(rc.Left,rc.Top,rc.Right-rc.Left+1,rc.Bottom-rc.Top+1);
  164.   end;
  165.  
  166. begin
  167.     pt := ClientToScreen(Point(X,Y));
  168.     xDif := pt.X - ptDown.X;
  169.   yDif := pt.Y - ptDown.Y;
  170.     if ssLeft in Shift then
  171.     case dragging of
  172.     -1:    SetBounds(left + (X-xDown),top + (Y-yDown),width,height);
  173.     0: SetW(xDif,yDif,0,0);
  174.     1: SetW(0,yDif,0,0);
  175.     2: SetW(0,yDif,xDif,0);
  176.     3: SetW(0,0,xDif,0);
  177.     4: SetW(0,0,xDif,yDif);
  178.     5: SetW(0,0,0,yDif);
  179.     6: SetW(xDif,0,0,yDif);
  180.     7: SetW(xDif,0,0,0);
  181.     end
  182.   else begin
  183.          pt := Point(X,Y);
  184.       Cursor := crArrow;
  185.       for i := 0 to 7 do
  186.             if PtInRect(rcDrag[i],pt) then
  187.           Cursor := rcCursor[i];
  188.   end;
  189. end;
  190.  
  191. procedure THotspot.MouseDown(Sender: TObject; Button: TMouseButton; Shift:
  192. TShiftState; X, Y: Integer);
  193. var
  194.     i: Integer;
  195.   pt: TPoint;
  196. begin
  197.      pt := Point(X,Y);
  198.   ptDown := ClientToScreen(pt);
  199.     xDown := X;
  200.   yDown := Y;
  201.   rcDown := Rect(left,top,left+Width,top+Height);
  202.   dragging := -1;
  203.   for i := 0 to 7 do
  204.         if PtInRect(rcDrag[i],pt) then
  205.         dragging := i;
  206.   if dragging <> -1 then
  207.       Cursor := rcCursor[i]
  208.   else if Cursor <> crArrow then
  209.       Cursor := crArrow;
  210.   Paint;
  211. end;
  212.  
  213. procedure THotspot.MouseUp(Sender: TObject; Button: TMouseButton; Shift:
  214. TShiftState; X, Y: Integer);
  215. begin
  216.     dragging := -1;
  217.   Paint;
  218. end;
  219.  
  220. end.
  221.  
  222.  
  223.